perm filename MEM.OL2[GEM,BGB] blob sn#038349 filedate 1973-04-27 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	TITLE MEM
C00003 00003	NSUBR MORCOR		Get more core			*
C00005 00004	SUBRS MKNODE,KLNODE	Make and Kill nodes		*
C00007 ENDMK
C⊗;
TITLE MEM

INTERN OLD44,UNIVER,BLKCNT,AVAIL
	OLD44:	0	;ORIGINAL JOBREL 44 CONTENTS.
	UNIVER:	0	;POINTER TO UNIVERSE NODE.
	BLKCNT: 0	;NUMBER OF NON EMPTY NODES.
	AVAIL:	0	;POINTER TO FIRST EMPTY NODE.
	REMAINDER:0	;NUMBER OF UNUSED WORDS BETWEEN 
			; THE TOP OF NODE SPACE AND THE TOP OF CORE.
	NODSIZ←←=12	;NUMBER OF WORDS PER NODE.
NSUBR MORCOR		;Get more core			*

;INITIALIZE THE UNIVERSE NODE WHEN NECESSARY.
	SKIPE OLD44↔GO L1		;SKIP ON FIRST TIME ONLY.
	LAC 1,44↔DAC 1,OLD44		;SAVE JOBREL.
	ADDI 1,1↔			;SETUP UNIVERSE NODE.
	ADDI 1,1↔DAC 1,AVAIL
	ADDI 1,1↔DAC 1,BLKCNT
	ADDI 1,1↔DAC 1,UNIVERSE
	SETZM REMAINDER

;FOUR MORE K.
L1:	LAC 1,44↔LAC 0,1↔ADDI 0,10000
	CALLI 11↔FATAL<NO MORE CORE.>
	AOS 1↔SUB 1,REMAINDER↔DAC 2,AC2#↔LAC 2,44
	SETZM(1)↔LIPI(1)↔LAPI(1)1↔BLT(2)
	LACI 2↔DAP @UNIVERSE

;MAKE AVAIL LIST.
	DIP 1,1↔ADD 1,[XWD NODSIZ,0]
	SKIPN@BLKCNT↔GO[
		ADD 1,[XWD NODSIZ,NODSIZ]
		AOS@BLKCNT↔GO .+1]
	DAPZ 1,@AVAIL
L2:	HLRZM 1,(1)↔AOS 3(1)	;EMPTY LINK & EMPTY TYPE-1.
	ADD 1,[XWD NODSIZ,NODSIZ]
	CAILE 2,NODSIZ+NODSIZ-1(1)
	GO L2↔AOS 3(1)

	SUBI 2,NODSIZ-1(1)↔DAC 2,REMAINDER
	LACI 10000↔LAC 1,UNIVER↔ADDM -3(1)	;CORE SIZE.
	LAC 1,@AVAIL
	LAC 2,AC2↔POP0J
SUBREND MORCOR;4-DEC-72(BGB)
;SUBRS MKNODE,KLNODE	;Make and Kill nodes		*
;____________________________________________________________________

NSUBR MKNODE,NODTYP	;ALLOCATE A BLOCK OF NODSIZ WORDS. *
	SKIPN 1,@AVAIL↔CALL MORCOR	;GET AN EMPTY NODE.
	CDR(1)↔DAP @AVAIL
	SETZM(1)↔AOS @BLKCNT↔ADDI 1,3
	POP P,RETADR#			;SAVE RETURN ADDRESS.
	POP P,(1)			;PLACE NODE TYPE INTO NODE.
	GO @RETADR			;RETURN.
SUBREND MKNODE;4-DEC-72(BGB)
;____________________________________________________________________

NSUBR KLNODE,NODE	;RELEASE  BLOCK OF NODSIZ WORDS.
	LAC 1,NODE↔SOS @BLKCNT
	LIPI -3(1)↔LAPI -2(1)		;CLEAR NODE.
	SETZM -3(1)↔BLT 8(1)
	AOS(1)				;MARK NODE TYPE EMPTY-1.
	SUBI 1,3↔LAC@AVAIL		;CONS NODE TO AVAIL LIST.
	DAPZ(1)↔DAPZ 1,@AVAIL
	POP1J
SUBREND KLNODE;4-DEC-72(BGB)